COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	 trian2.lsp[f82,jmc]	How many queens will fit in a triangle
C00006 ENDMK
C⊗;
;;; trian2.lsp[f82,jmc]	How many queens will fit in a triangle
; version using defstruct
(declare (special rank1 pos))

(defun solutions (pos sols)
       (if (terp pos)
	   (if (winp pos) (cons (outform pos) sols) sols)
	   (do ((m (moves pos) (cdr m))
		(s1 sols (solutions (update (car m) pos) s1)))
	       ((null m) s1))))

(defun moves (pos)
       (cons 0 (do ((i 1 (1+ i))
		    (l nil (if (ok i (ranklist pos))
			       (cons i l)
			       l)))
		   ((= i (1+ (- n (filenum pos)))) l))))

(defstruct (position (constructor make-pos (ranklist filenum nqueens)))
	   ranklist
	   filenum
	   nqueens)

;(defun make-pos (u m n) (list u m n))

;(defun ranklist (pos) ; a list of the ranks occupied in each file
;      (car pos))	; 0 means the rank is unoccupied

;(defun filenum (pos) ; the number of the first available file
;      (cadr pos))

;(defun nqueens (pos) ; the number of queens so far placed
;      (caddr pos))


(defun ok (r list) (and (or (not (= r 1)) (not (< (filenum pos) rank1)))
			(ok1 r list 1)))

(defun ok1 (r list n)
       (or (null list)
	   (and (ok2 r (car list) n)
		(ok1 r (cdr list) (1+ n)))))

(defun ok2 (r r1 delta) (or (zerop r1) (not (or (= r r1)
						(= r (+ r1 delta))
						(= r (- r1 delta)) ))))

(defun terp (pos) (= n (filenum pos)))

(defun winp (pos) (not (< (nqueens pos) nwin)))

(defun update (m pos) (progn (if (null (ranklist pos)) (setq rank1 m))
			     (make-pos (cons m (ranklist pos))
				       (1+ (filenum pos))
				       (if (= m 0)
					   (nqueens pos)
					   (1+ (nqueens pos))))))

(defun outform (pos) (list (reverse (ranklist pos)) (nqueens pos)))

(setq rank1 0) ; used to avoid generating some symmetric solutions

(setq init-pos (make-pos nil 0 0))

(setq base (setq ibase 10.))

(defun test (m0 n0) (progn (setq n m0) (setq nwin n0)
			   (solutions init-pos nil)))

;bfun